home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbucmdmc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  5.4 KB  |  173 lines
  1. (*===========================================================================*)
  2. (* Mode change subroutine                                                    *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$UNDEF DEBUG_MC}
  10.  
  11. PROCEDURE user_wants_sysop;
  12.  
  13.   LABEL no_exit,
  14.         ok_exit;
  15.  
  16.   BEGIN;
  17.  
  18.     {$IFDEF DEBUG_MC}
  19.       WRITELN('User wants sysop');
  20.     {$ENDIF}
  21.  
  22.     (*-----------------------------------------------------------------------*)
  23.     (* If this is the local console, things are ok                           *)
  24.     (*-----------------------------------------------------------------------*)
  25.  
  26.     IF active_tcb^.tcb_console THEN
  27.       GOTO ok_exit;
  28.  
  29.     {$IFDEF DEBUG_MC}
  30.       WRITELN('Console test failed');
  31.     {$ENDIF}
  32.  
  33.     (*-----------------------------------------------------------------------*)
  34.     (* If this user cannot be a sysop, quit now                              *)
  35.     (*-----------------------------------------------------------------------*)
  36.  
  37.     IF (active_tcb^.uid_data.user_flag AND user_f_sysop) = 0 THEN
  38.       GOTO no_exit;
  39.  
  40.     (*-----------------------------------------------------------------------*)
  41.     (* If remote sysops cannot use this port, quit now                       *)
  42.     (*-----------------------------------------------------------------------*)
  43.  
  44.     IF NOT active_port^.port_r_sysop THEN
  45.       GOTO no_exit;
  46.  
  47.     (*-----------------------------------------------------------------------*)
  48.     (* If user authenicated already, then we are done                        *)
  49.     (*-----------------------------------------------------------------------*)
  50.  
  51.     {$IFDEF DEBUG_MC}
  52.       WRITELN('Password done already test');
  53.     {$ENDIF}
  54.  
  55.     IF active_tcb^.tcb_sysop_pw_ok THEN
  56.       GOTO ok_exit;
  57.  
  58.     (*-----------------------------------------------------------------------*)
  59.     (* If this port and user don't require authentication, then we are done  *)
  60.     (*-----------------------------------------------------------------------*)
  61.  
  62.     {$IFDEF DEBUG_MC}
  63.       WRITELN('Authenticate needed test');
  64.     {$ENDIF}
  65.  
  66.     IF ((active_tcb^.uid_data.user_access.access_flags
  67.                 OR active_port^.dflt_access.access_flags)
  68.                                                    AND access_f_sysop) = 0 THEN
  69.       GOTO ok_exit;
  70.  
  71.     (*-----------------------------------------------------------------------*)
  72.     (* Authenticate!                                                         *)
  73.     (*-----------------------------------------------------------------------*)
  74.  
  75.     {$IFDEF DEBUG_MC}
  76.       WRITELN('Authenticate');
  77.     {$ENDIF}
  78.  
  79.     user_auth(cmd_string);
  80.  
  81.     {$IFDEF DEBUG_MC}
  82.       WRITELN('Authenticate result -- ', active_tcb^.error_sw);
  83.     {$ENDIF}
  84.  
  85.     (*-----------------------------------------------------------------------*)
  86.     (* Authentication worked.  Go to routine                                 *)
  87.     (*-----------------------------------------------------------------------*)
  88.  
  89.     IF NOT active_tcb^.error_sw THEN
  90.       GOTO ok_exit;
  91.  
  92.     (*-----------------------------------------------------------------------*)
  93.     (* All authentication failures come here                                 *)
  94.     (*-----------------------------------------------------------------------*)
  95.  
  96. no_exit:
  97.  
  98.     active_tcb^.error_sw := TRUE;
  99.  
  100.     EXIT;
  101.  
  102.     (*-----------------------------------------------------------------------*)
  103.     (* All successes come here                                               *)
  104.     (*-----------------------------------------------------------------------*)
  105.  
  106. ok_exit:
  107.  
  108.     active_tcb^.uid_data.user_class := user_c_rsu;
  109.     active_tcb^.tcb_sysop_pw_ok     := TRUE;
  110.  
  111.   END;
  112.  
  113.  
  114. PROCEDURE user_mode_change;
  115.  
  116.   BEGIN;
  117.  
  118.     IF word_count > 1 THEN
  119.       BEGIN;
  120.         send_message(message_err_wrd);
  121.         active_tcb^.error_sw := TRUE;
  122.         EXIT;
  123.       END;
  124.  
  125.     IF LENGTH(cmd_word) > 2 THEN
  126.       BEGIN;
  127.         send_message(message_err_wrd);
  128.         active_tcb^.error_sw := TRUE;
  129.         EXIT;
  130.       END;
  131.  
  132.     IF LENGTH(cmd_word) = 1 THEN
  133.       cmd_word[2] := 'R';
  134.  
  135.     WITH active_tcb^, active_tcb^.uid_data DO
  136.       CASE cmd_word[2] OF
  137.         '?' : ;
  138.         'N' : user_class := user_c_nu;
  139.         'U' : user_class := user_c_uu;
  140.         'O' : user_class := user_c_ou;
  141.         'E' : user_class := user_c_eu;
  142.         'B' : user_class := user_c_bu;
  143.  
  144.         'R' : user_wants_sysop; (* All flags set in this routine *)
  145.  
  146.         'L' : BEGIN;
  147.                 IF tcb_console THEN
  148.                   user_class := user_c_lsu
  149.                 ELSE
  150.                   error_sw := TRUE;
  151.               END;
  152.  
  153.         ELSE
  154.           error_sw := TRUE;
  155.  
  156.       END;
  157.  
  158.     IF active_tcb^.error_sw THEN
  159.       BEGIN;
  160.         CASE active_tcb^.tcb_error_reason OF
  161.           0 : send_message(message_err_2nd);
  162.           1 : BEGIN;
  163.                 send_message(message_auth_incomplete);
  164.                 send_message(message_mode_switch);
  165.               END;
  166.           ELSE ;
  167.         END;
  168.       END
  169.     ELSE
  170.       send_message(message_mode_switch);
  171.  
  172.   END;
  173.